home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1997
/
HAM Radio 1997.iso
/
vcls
/
srctt26
/
timeunit.pas
< prev
Wrap
Pascal/Delphi Source File
|
1996-04-08
|
16KB
|
496 lines
unit Timeunit;
{----------------------------------------------------------------------
Written by Dan Statham, July/August 1995.
Copyright: Dan Statham, July 1995.
The program will keep track of the hours/minutes/seconds that
you are connected to an Internet provider or an online service.
------------------------------------------------------------------------}
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus,
About, PreSetUn, FreeHrs, IniFiles, AnaClock, Balloon;
type
TMainForm = class(TForm)
MainMenu: TMainMenu;
FileExitItem: TMenuItem;
SpeedBar: TPanel;
Timer1: TTimer;
SpeedButton6: TSpeedButton;
Timer2: TMenuItem;
Start1: TMenuItem;
Stop1: TMenuItem;
Reset1: TMenuItem;
PreSet1: TMenuItem;
PopupMenu1: TPopupMenu;
StartStop1: TMenuItem;
Reset2: TMenuItem;
PreSet2: TMenuItem;
N1: TMenuItem;
About1: TMenuItem;
N2: TMenuItem;
Exit1: TMenuItem;
SetFree1: TMenuItem;
SetFreeHours1: TMenuItem;
Setup1: TMenuItem;
AnalogClock1: TAnalogClock;
BalloonHint1: TBalloonHint;
KeepLog1: TMenuItem;
KeepLog2: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FileExit(Sender: TObject);
procedure Start1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Stop1Click(Sender: TObject);
procedure Reset1Click(Sender: TObject);
procedure HelpAboutItemClick(Sender: TObject);
procedure PreSet1Click(Sender: TObject);
procedure StartStop1Click(Sender: TObject);
procedure SetFree1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure AnalogClock1Click(Sender: TObject);
procedure WinMsg(var Msg:TMsg; var Handled:Boolean);
procedure KeepLog (SpeedButton6 :TSpeedButton; DiffTime, MyTime :String);
procedure KeepLog1Click(Sender: TObject);
private
procedure SetMyTime (Hours, Minutes, Seconds : Integer;
Hr, Min, Sec :String; var MyTime : String);
procedure FindRealHours (var RealHours : Real);
end;
var
MainForm : TMainForm;
Hours ,Minutes, Seconds : Integer;
StartHour, StartMinutes, StartSeconds : Integer;
StopHour, StopMinutes, StopSeconds : Integer;
DiffHour, DiffMinutes, DiffSeconds : Integer;
BeginHour, BeginMinutes, BeginSeconds : Integer;
EndHour, EndMinutes, EndSeconds : Integer;
Hr, Min, Sec, MyTime, Hour : String;
WarnMessage, FrHrs : String;
AddCostText : String;
BeginTime, EndTime : String;
DiffTime : String;
NewItem : String;
DiffH, DiffM, DiffS : String;
AdditionalCost : Real;
RealHours : Real;
TotalSeconds : Real;
NotShown : Boolean;
MenuFlag : Boolean;
KeepLogBool : Boolean;
hSysMenu : HMenu;
Log : Text;
implementation
{$R *.DFM}
const ItemID=99;
procedure TMainForm.FormCreate(Sender: TObject);
begin
Application.OnMessage:=WinMsg;
hSysMenu := GetSystemMenu (MainForm.Handle, False);
AppendMenu (hSysMenu, MF_SEPARATOR, $A9, nil);
AppendMenu (hSysMenu, MF_STRING, ItemID, 'Start Timer');
AppendMenu (hSysMenu, MF_STRING, ItemID+1, 'About');
RealHours := 0.0;
TotalSeconds := 0;
with TIniFile.Create ('Win.Ini') do
try
Hours := ReadInteger ('OnLineTime Tracker', 'Hours', 0);
Minutes := ReadInteger ('OnLineTime Tracker', 'Minutes', 0);
Seconds := ReadInteger ('OnLineTime Tracker', 'Seconds', 0);
FreeHours := ReadInteger ('OnLineTime Tracker', 'FreeHours', 40);
WarningLevel := ReadInteger ('OnLineTime Tracker',
'WarningLevel', 90);
PerHourCost := ReadInteger ('OnLineTime Tracker', 'PerHourCost', 195);
Left := ReadInteger ('OnLineTime Tracker', 'Left', 354);
Top := ReadInteger ('OnLineTime Tracker', 'Top', 118);
Width := ReadInteger ('OnLineTime Tracker', 'Width', 247);
Height := ReadInteger ('OnLineTime Tracker', 'Height', 102);
KeepLogBool := ReadBool ('OnLineTime Tracker', 'KeepLog', True);
finally
Free;
end;
Timer1.Enabled := False;
SpeedButton6.Down := False;
NotShown := True;
SetMyTime (Hours, Minutes, Seconds, Hr, Min, Sec, MyTime);
FindRealHours (RealHours);
KeepLog1.Checked := KeepLogBool;
end;
procedure TMainForm.WinMsg(var Msg :TMsg; var Handled :Boolean);
{From: JCIRIELL@physiology.uwo.ca
Subject: Here is a Tip for Delphi
Date: Tue, 8 Aug 1995 10:45:07 EDT}
begin
if Msg.Message=WM_Syscommand then{if the message is a system one...}
if Msg.WParam = ItemID then
AnalogClock1Click (nil)
else
if msg.wparam = ItemID + 1 then
HelpAboutItemClick (nil);
end;
procedure TMainForm.FindRealHours(var RealHours : Real);
begin
TotalSeconds := (Hours * 36000)/10;
TotalSeconds := TotalSeconds + (Minutes * 60);
TotalSeconds := TotalSeconds + Seconds;
RealHours := TotalSeconds / 3600;
end;
procedure TMainForm.FileExit(Sender: TObject);
begin
Close;
end;
procedure TMainForm.Start1Click(Sender: TObject);
begin
AnalogClock1.FaceColor := clBtnFace;
Timer1.Enabled := True;
SpeedButton6.Down := True;
BeginTime := TimeToStr (Time);
StartHour := Hours;
StartMinutes := Minutes;
StartSeconds := Seconds;
if Length (BeginTime) = 11 then
begin
BeginHour := StrToInt(Copy (BeginTime , 1, 2));
BeginMinutes := StrToInt(Copy (BeginTime, 4, 2));
BeginSeconds := StrToInt(Copy (BeginTime, 7, 2));
end
else
if Length (BeginTime) = 10 then
begin
BeginHour := StrToInt(Copy (BeginTime , 1, 1));
BeginMinutes := StrToInt(Copy (BeginTime, 3, 2));
BeginSeconds := StrToInt(Copy (BeginTime, 6, 2));
end;
end;
procedure TMainForm.KeepLog (SpeedButton6 :TSpeedButton;
DiffTime, MyTime :String);
var
I : Integer;
begin
AssignFile (Log, 'TimeTrack.Log');
try
Append (Log);
except
Rewrite (Log);
WriteLn (Log, 'OnLineTime Tracker Log':46);
WriteLn (Log, '~~~~~~~~~~~~~~~~~~~~~~':46);
WriteLn (Log, 'Connected at':13, 'Disconnected at':24,
'Connected Time':20, 'Total Time':13);
for I := 1 to 69 do
Write (Log, '~');
WriteLn (Log, '~');
end;
if SpeedButton6.Down then
Write (Log, DateTimeToStr (Now):19)
else
WriteLn (Log, DateTimeToStr (Now):21, DiffTime:11, MyTime:17);
CloseFile (Log);
end;
procedure TMainForm.Timer1Timer(Sender: TObject);
var
RealFreeHours, RealPerHourCost, TimeOver : Real;
begin
Inc (Seconds);
if Seconds = 60 then
begin
Seconds := 0;
Inc (Minutes);
end;
if Minutes = 60 then
begin
Minutes := 0;
Inc (Hours);
end;
RealHours := RealHours + 0.0002777777;
if FreeHours > 0 then
begin
if Hours >= FreeHours then
begin
RealFreeHours := FreeHours;
RealPerHourCost := PerHourCost;
TimeOver :=RealHours - FreeHours;
AdditionalCost := TimeOver *
(RealPerHourCost / 100);
Str (AdditionalCost:5:2, AddCostText);
end;
if (Hours >= FreeHours) and NotShown then
begin
NotShown := False;
Hour := IntToStr (Hours);
FrHrs := IntToStr (FreeHours);
MessageBeep (48);
WarnMessage := 'You have used up your '+ FrHrs +
' "free" hours! Watch the title '+
'bar to see your additional cost add up!';
MessageDlg (WarnMessage, mtWarning, [mbOK], 0);
end
else if (Hours >= (FreeHours * WarningLevel div 100))
and (NotShown) then
begin
NotShown := False;
Hour := IntToStr (Hours);
FrHrs := IntToStr (FreeHours);
MessageBeep (48);
WarnMessage := Hour + ' hours of your '+ FrHrs +
' "free" hours have already been used up!';
MessageDlg (WarnMessage, mtWarning, [mbOK], 0);
end;
end;
SetMyTime (Hours, Minutes, Seconds, Hr, Min, Sec, MyTime);
end;
procedure TMainForm.SetMyTime (Hours, Minutes, Seconds : Integer;
Hr, Min, Sec :String; var MyTime : String);
begin
Hr := IntToStr (Hours);
if Length(Hr) = 1 then
Hr := '0' + Hr;
Min := IntToStr (Minutes);
if Length (Min) = 1 then
Min := '0' + Min;
Sec := IntToStr (Seconds);
if Length (Sec) = 1 then
Sec := '0' + Sec;
if FreeHours > 0 then
if Hours >= FreeHours then
MyTime := Hr + ':' + Min + ':' + Sec + ' $$' + AddCostText
else
MyTime := Hr + ':' + Min + ':' + Sec
else
MyTime := Hr + ':' + Min + ':' + Sec;
MainForm.Caption := MyTime;
end;
procedure TMainForm.Stop1Click(Sender: TObject);
begin
AnalogClock1.FaceColor := clAqua;
Timer1.Enabled := False;
SpeedButton6.Down := False;
NotShown := True;
AddCostText := '';
EndTime := TimeToStr (Time);
if Length (EndTime) = 11 then
begin
EndHour := StrToInt(Copy (EndTime , 1, 2));
EndMinutes := StrToInt(Copy (EndTime, 4, 2));
EndSeconds := StrToInt(Copy (EndTime, 7, 2));
end
else
if Length (EndTime) = 10 then
begin
EndHour := StrToInt(Copy (EndTime , 1, 1));
EndMinutes := StrToInt(Copy (EndTime, 3, 2));
EndSeconds := StrToInt(Copy (EndTime, 6, 2));
end;
if EndHour < BeginHour then
DiffHour := (12 - BeginHour) + EndHour
else
DiffHour := EndHour - BeginHour;
if EndMinutes < BeginMinutes then
begin
DiffMinutes := EndMinutes + (60 - BeginMinutes);
DiffHour := DiffHour -1;
end
else if EndMinutes >= BeginMinutes then
DiffMinutes := EndMinutes - BeginMinutes ;
if EndSeconds < BeginSeconds then
begin
DiffSeconds := EndSeconds + (60 - BeginSeconds);
DiffMinutes := DiffMinutes -1;
end
else if EndSeconds >= BeginSeconds then
DiffSeconds := EndSeconds - BeginSeconds;
Hours := StartHour + DiffHour;
Minutes := StartMinutes + DiffMinutes;
Seconds := StartSeconds + DiffSeconds;
DiffH := IntToStr (DiffHour);
if DiffHour < 10 then
DiffH := '0' + DiffH;
DiffM := IntToStr (DiffMinutes);
if DiffMinutes < 10 then
DiffM := '0' + DiffM;
DiffS := IntToStr (DIffSeconds);
if DiffSeconds < 10 then
DiffS := '0' + DiffS;
DiffTime := DiffH + ':' + DiffM + ':' + DiffS;
if Seconds >= 60 then
begin
Seconds := Seconds - 60;
Minutes := Minutes + 1;
end;
if Minutes >= 60 then
begin
Minutes := Minutes - 60;
Hours := Hours + 1;
end;
SetMyTime (Hours, Minutes, Seconds, Hr, Min, Sec, MyTime);
with TIniFile.Create ('Win.Ini') do
try
WriteInteger ('OnLineTime Tracker', 'Hours', Hours);
WriteInteger ('OnLineTime Tracker', 'Minutes', Minutes);
WriteInteger ('OnLineTime Tracker', 'Seconds', Seconds);
WriteInteger ('OnLineTime Tracker', 'FreeHours', FreeHours);
WriteInteger ('OnLineTime Tracker',
'WarningLevel', WarningLevel);
finally
Free;
end;
end;
procedure TMainForm.Reset1Click(Sender: TObject);
begin
MessageBeep (32);
if MessageDlg ('Reset your time to 00:00:00?',
mtConfirmation, mbOKCancel, 0) = mrOK then
begin
Hours := 0;
Minutes := 0;
Seconds := 0;
SetMyTime (Hours, Minutes, Seconds, Hr, Min, Sec, MyTime);
with TIniFile.Create ('Win.Ini') do
try
WriteInteger ('OnLineTime Tracker', 'Hours', Hours);
WriteInteger ('OnLineTime Tracker', 'Minutes', Minutes);
WriteInteger ('OnLineTime Tracker', 'Seconds', Seconds);
finally
Free;
end;
end;
end;
procedure TMainForm.HelpAboutItemClick (Sender: TObject);
begin
AboutBox := TAboutBox.Create (Self);
AboutBox.ShowModal;
AboutBox.Free;
end;
procedure TMainForm.PreSet1Click(Sender: TObject);
begin
BtnRightDlg := TBtnRightDlg.Create (Self);
BtnRightDlg.ShowModal;
if BtnRightDlg.ModalResult = mrOK then
begin
Hours := Hrs;
Minutes := Mins;
Seconds := Secs;
SetMyTime (Hours, Minutes, Seconds, Hr, Min, Sec, MyTime);
with TIniFile.Create ('Win.Ini') do
try
WriteInteger ('OnLineTime Tracker', 'Hours', Hours);
WriteInteger ('OnLineTime Tracker', 'Minutes', Minutes);
WriteInteger ('OnLineTime Tracker', 'Seconds', Seconds);
finally
Free;
end;
end;
BtnRightDlg.Free;
end;
procedure TMainForm.StartStop1Click(Sender: TObject);
begin
if not SpeedButton6.Down then
begin
Start1.Click;
SpeedButton6.Down := True;
end
else
begin
Stop1.Click;
SpeedButton6.Down := false;
end;
if KeepLog1.Checked then
KeepLog (SpeedButton6, DiffTime, MyTime);
end;
procedure TMainForm.SetFree1Click(Sender: TObject);
begin
FreeHoursDlg := TBtnBottomDlg.Create (Self);
FreeHoursDlg.ShowModal;
FreeHoursDlg.Free;
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
with TIniFile.Create ('Win.Ini') do
try
WriteInteger ('OnLineTime Tracker', 'Hours', Hours);
WriteInteger ('OnLineTime Tracker', 'Minutes', Minutes);
WriteInteger ('OnLineTime Tracker', 'Seconds', Seconds);
WriteInteger ('OnLineTime Tracker', 'FreeHours', FreeHours);
WriteInteger ('OnLineTime Tracker',
'WarningLevel', WarningLevel);
WriteInteger ('OnLineTime Tracker', 'PerHourCost', PerHourCost);
WriteInteger ('OnLineTime Tracker', 'Left', Left);
WriteInteger ('OnLineTime Tracker', 'Top', Top);
WriteInteger ('OnLineTime Tracker', 'Width', Width);
WriteInteger ('OnLineTime Tracker', 'Height', Height);
WriteBool ('OnLineTime Tracker', 'KeepLog', KeepLogBool);
finally
Free;
end;
end;
procedure TMainForm.AnalogClock1Click;
begin
MenuFlag := not MenuFlag;
if not MenuFlag then
begin
DeleteMenu (hSysMenu, ItemID, MF_BYCOMMAND);
InsertMenu (hSysMenu, ItemID + 1, MF_STRING, ItemID, 'Stop Timer');
end
else
begin
DeleteMenu (hSysMenu, ItemID, MF_BYCOMMAND);
InsertMenu (hSysMenu, ItemID + 1, MF_STRING, ItemID, 'Start Timer');
end;
if not SpeedButton6.Down then
begin
Start1.Click;
SpeedButton6.Down := True;
end
else
begin
Stop1.Click;
SpeedButton6.Down := False;
end;
if KeepLog1.Checked then
KeepLog (SpeedButton6, DiffTime, MyTime);
end;
procedure TMainForm.KeepLog1Click(Sender: TObject);
begin
if not SpeedButton6.Down then
begin
KeepLog1.Checked := not KeepLog1.Checked;
KeepLogBool := KeepLog1.Checked;
end;
end;
initialization
MenuFlag := True;
end.